home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / games.arc / CUBE.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  9.3 KB  |  399 lines
  1. 7  ' Source:  Printed copy offered in
  2. 8  '          PC Magazine, Vol. 1, No. 2, pp. 85-87
  3. 9  ' (all comments omitted)
  4. 10  '                          RUBIK'S CUBE SIMULATOR
  5. 20  '                                 PC MAGAZINE
  6. 30  '                                 march, 1982
  7. 40  '                                 karl koessel
  8. 50  SCREEN 0,1,0,0
  9. 60  COLOR 7,0,1
  10. 70  CLS
  11. 80  KEY OFF
  12. 90  CLEAR,,2000
  13. 100  DEFINT A-Z
  14. 110  DIM HOLD(20)
  15. 120  GOSUB 3240
  16. 130  GOSUB 3620
  17. 140  GOSUB 3680
  18. 150  GOSUB 3770
  19. 160  GOSUB 600
  20. 190  GOSUB 2760
  21. 200  COLOR 23
  22. 210  PRINT "Enter ";
  23. 220  COLOR 7
  24. 230  INPUT "a twist or command: ",TWIST$
  25. 240  IF TWIST$="" THEN 190
  26. 250  GOSUB 1860
  27. 260  REQ$=TWIST$
  28. 270  GOSUB 820
  29. 280  IF D THEN 190
  30. 290  GOSUB 910
  31. 300  GOTO 190
  32. 320  GOSUB 2760
  33. 330  PRINT "Press [RETURN] to twist the ";
  34. 340  IF CLRMON THEN COLOR BR(F) ELSE COLOR 1
  35. 350  PRINT PLACE$(1,F);
  36. 360  COLOR 7
  37. 370  PRINT " face ";
  38. 380  IF CLRMON THEN COLOR BR(F) ELSE COLOR 1
  39. 390  PRINT DIRECTION$(OSO)
  40. 400  COLOR 7
  41. 410  IF CLRMON AND BIG THEN 430
  42. 420  PRINT SPC(13)
  43. 430  PRINT "or enter a new twist or command: ";
  44. 440  INPUT "",GO$
  45. 450  GOSUB 1860
  46. 460  IF GO$="" THEN 530
  47. 470  REQ$=,GO$
  48. 480  GOSUB 820
  49. 490  ON D GOTO 320,320,320,320,510,320,320,320,530
  50. 500  GOSUB 910
  51. 510  RETURN
  52. 530  GOSUB 2360
  53. 540  GOSUB 2520
  54. 550  GOSUB 1900
  55. 560  GOSUB 2000
  56. 570  GOSUB 1590
  57. 580  RETURN
  58. 600  GOSUB 1900
  59. 610  IF CLRMON THEN WIDTH 40:BIG=-1
  60. 620  IF NOT BIG AND D=8 THEN RETURN
  61. 630  GOSUB 2790
  62. 640  IF D<>8 THEN GOSUB 2610
  63. 650  IF NOT BIG THEN 690
  64. 660  GOSUB 3020
  65. 670  CLS
  66. 680  GOSUB 3040
  67. 690  GOSUB 1290
  68. 700  RETURN
  69. 720  RQ$=""
  70. 730  FOR K=1 TO LEN(REQ$)
  71. 740      RK$=MID$(REQ$,K,1)
  72. 750      IF RK$="'" THEN 770
  73. 760      RK$=CHR$((ASC(RK$) AND 95))
  74. 770      RQ$=RQ$+RK$
  75. 780  NEXT
  76. 790  REQ$=RQ$
  77. 800  RETURN
  78. 820  GOSUB 720
  79. 830  D=0
  80. 840  FOR DMI=1 TO 9
  81. 850      IF LEFT$(REQ$,LEN(DM$(DMI)))=DM$(DMI) THEN D=DMI
  82. 860  NEXT
  83. 870  IF D>0 AND D<4 THEN DM=D-1
  84. 880  ON D GOSUB 1590,1590,1590,1380,600,1210,2040,610,1350
  85. 890  RETURN
  86. 910  GOSUB 1900
  87. 930  IF MID$(REQ$,2,1)=""OR MID$(REQ$,2,1)="'"AND LEN(REQ$)<3 THEN 960
  88. 940  GOTO 1020
  89. 960  F=0
  90. 970  FOR W=1 TO LEN(T$)
  91. 980      IF LEFT$(REQ$,1)=MID$(T$,W,1) THEN F=W:TWIST$=REQ$
  92. 990  NEXT
  93. 1000  IF F THEN 1100
  94. 1020  GOSUB 2760
  95. 1030  PRINT "Input ";:COLOR 23:PRINT "NOT";:COLOR 7:PRINT " recognized"
  96. 1040  PRINT "    One moment please..."
  97. 1050  GOSUB 1590
  98. 1060  GOSUB 1860
  99. 1070  RETURN
  100. 1100  IF MID$(REQ$,2,1)="'" THEN OSO=2:OSI=1 ELSE OSO=0:OSI=5
  101. 1120  GOSUB 2200
  102. 1130  GOSUB 2260
  103. 1150  GOSUB 2460
  104. 1170  IF SKIP THEN 530
  105. 1180  GOSUB 1590
  106. 1190  GOTO 320
  107. 1210  IF NOT CLRMON THEN 1330
  108. 1220  BIG=NOT BIG
  109. 1230  IF BIG THEN WIDTH 40:GOTO 1260
  110. 1240  WIDTH 80
  111. 1250  GOSUB 2790
  112. 1260  GOSUB 1290
  113. 1270  RETURN
  114. 1290  IF BIG THEN GOSUB 3060
  115. 1300  GOSUB 1390
  116. 1310  GOSUB 1590
  117. 1320  IF NOT BIG THEN GOSUB 2040
  118. 1330  RETURN
  119. 1350  SKIP=NOT SKIP
  120. 1360  RETURN
  121. 1380  LABEL = NOT LABEL
  122. 1390  FOR FA=1 TO 6
  123. 1400      IF BIG THEN LOCATE XBL(FA),YBL(FA):GOTO 1420
  124. 1410      LOCATE X(FA)+2,Y(FA)-1
  125. 1420      IF NOT LABEL GOTO 1460
  126. 1430      IF CLRMON THEN COLOR BR(FA) ELSE COLOR 1
  127. 1440      PRINT PLACE$(1,FA);
  128. 1450      GOTO 1470
  129. 1460      PRINT SPC(5);
  130. 1470  NEXT
  131. 1480  IF NOT BIG THEN 1570
  132. 1490  FOR XBL=1 TO 2
  133. 1500      LOCATE XBL+4,19-XBL
  134. 1510      IF NOT LABEL THEN GOTO 1540
  135. 1520      COLOR BR(3)
  136. 1530      PRINT "/";
  137. 1540      PRINT " "
  138. 1550  NEXT
  139. 1560  COLOR 7
  140. 1570  RETURN
  141. 1590  DB=1:DUB=0
  142. 1600  IF BIG THEN DB=2
  143. 1610  FOR FA=1 TO 6
  144. 1620  FOR P=0 TO 8
  145. 1630  IF BIG THEN FOR DUB=0 TO 1
  146. 1640      LOCATE X(FA)+XOF(P)*DB+DUB-REL(FA)*BIG,Y(FA)+YOF(P)+RELY(FA)*BIG
  147. 1650      BR=BR(FIX(CUBIE(FA,P,1)\10))
  148. 1660      IF BR THEN COLOR CUBIE(FA,P,2)*-16,BR:GOTO 1680
  149. 1670      IF CUBIE(FA,P,2) THEN COLOR 0,7 ELSE COLOR 7,0
  150. 1680      IF DUB THEN PRINT "  ";:GOTO 1710
  151. 1690      IF DM THEN PRINT USING "\\"; CUBIE$(FA,P,DM);                                         ELSE PRINT USING "**"; CUBIE(FA,P,1);
  152. 1710      ON P+1 GOTO 1730,1720,1720,1800,1800,1800,1740,1740,1730
  153. 1720      ND=1:GOTO 1760
  154. 1730      ND=4:GOTO 1760
  155. 1740      ND=-1:GOTO 1760
  156. 1760      IF BR THEN COLOR BR,BR(FIX(CUBIE(FA,(P+ND) MOD 12,1)\10)) ELSE 1780
  157. 1770      PRINT CHR$(221);:GOTO 1800
  158. 1780      IF CUBIE(FA,P,2)=CUBIE(FA,(P+ND) MOD 12,2) THEN 1790 ELSE COLOR 7,0
  159. 1790      PRINT " ";
  160. 1800  IF BIG THEN NEXT
  161. 1810  NEXT
  162. 1820  NEXT
  163. 1830  COLOR 7,0
  164. 1840  RETURN
  165. 1860  GOSUB 2760
  166. 1870  PRINT "One moment, please..."SPC(79)SPC(39)SPC(21)
  167. 1880  RETURN
  168. 1900  FOR J=1 TO 4
  169. 1910      FOR K=1 TO 3
  170. 1920          CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=0
  171. 1930      NEXT
  172. 1940  NEXT
  173. 1950  FOR P=1 TO 8
  174. 1960      CUBIE(F,P,2)=0
  175. 1970  NEXT
  176. 1980  RETURN
  177. 2000  TWISTSSOFAR$(AT)=TWISTSSOFAR$(AT)+TWIST$+" "
  178. 2010  IF LEN(TWISTSSOFAR$(AT))>36 THEN AT=AT+1
  179. 2020  IF BIG THEN RETURN
  180. 2040  LOCATE 18,1
  181. 2050  IF BIG THEN PRINT
  182. 2060  COLOR 1
  183. 2070  PRINT TWISTSSOFAR$(0);
  184. 2080  COLOR 7
  185. 2090  PRINT SPC(13)
  186. 2100  FOR K=1 TO AT
  187. 2110      PRINT TWISTSSOFAR$(K);
  188. 2120      IF NOT BIG THEN PRINT TWISTSSOFAR$(K+1);:K=K+1
  189. 2130      PRINT
  190. 2140  NEXT
  191. 2150  IF NOT BIG THEN RETURN
  192. 2160  GOSUB 3020
  193. 2170  GOSUB 1860
  194. 2180  RETURN
  195. 2200  FOR J=1 TO 4
  196. 2210      FACE(J)=VAL(MID$(OC$(F),J*2-1,1))
  197. 2220      POSITION(J)=VAL(MID$(OC$(F),J*2,1))
  198. 2230  NEXT
  199. 2240  RETURN
  200. 2260  FOR J=1 TO 4
  201. 2270      FOR K=1 TO 3
  202. 2290          HOLD((J-1)*3+K)=CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,1)
  203. 2310          CUBIE(FACE(J),((POSITION(J)+K-2) MOD 8)+1,2)=-1
  204. 2320      NEXT
  205. 2330  NEXT
  206. 2340  RETURN
  207. 2360  FOR J=1 TO 4
  208. 2370      FOR K=1 TO 3
  209. 2380          CUBIE(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)+K-2)                MOD 8)+1,1)=HOLD((J-1)*3+K)
  210. 2390          FOR DMI=1 TO 2
  211. 2400              CUBIE$(FACE(((J+OSO) MOD 4)+1),((POSITION(((J+OSO) MOD 4)+1)                    +K-2) MOD 8)+1,DMI)=PLACE$(DMI,FIX((HOLD((J-1)*3+K)\10)))
  212. 2410          NEXT
  213. 2420      NEXT
  214. 2430  NEXT
  215. 2440  RETURN
  216. 2460  FOR P=1 TO 8
  217. 2470      HOLD(12+P)=CUBIE(F,P,1)
  218. 2480      CUBIE(F,P,2)=-1
  219. 2490  NEXT
  220. 2500  RETURN
  221. 2520  FOR P=1 TO 8
  222. 2530      CUBIE(F,P,1)=HOLD(13+((P+OSI)MOD 8))
  223. 2540      FOR DMI=1 TO 2
  224. 2550          CUBIE$(F,P,DMI)=PLACE$(DMI,FIX(CUBIE(F,P,1)\10))
  225. 2560      NEXT
  226. 2570  NEXT
  227. 2580  RETURN
  228. 2610  FOR F = 1 TO 6
  229. 2620      FOR P = 0 TO 9
  230. 2630          CUBIE(F,P,1)=F*10+P
  231. 2640          FOR DMI=1 TO 2
  232. 2650              CUBIE$(F,P,DMI)=LEFT$(PLACE$(DMI,F),2)
  233. 2660          NEXT
  234. 2670      NEXT
  235. 2680  NEXT
  236. 2700  FOR K=1 TO AT
  237. 2710      TWISTSSOFAR$(K)=""
  238. 2720  NEXT
  239. 2730  AT=1
  240. 2740  RETURN
  241. 2760  IF BIG THEN LOCATE 19,1 ELSE LOCATE 15,1
  242. 2770  RETURN
  243. 2790  IF BIG THEN COLOR ,4:BG=3 ELSE BG=43
  244. 2800  CLS
  245. 2810  LOCATE 1,1+BG:COLOR 1:PRINT TITLE$
  246. 2820  LOCATE 3,3+BG:COLOR 7:PRINT"Each twist is called by the first"
  247. 2830  LOCATE 4,BG:PRINT"letter of the face you wish to twist:"
  248. 2840  LOCATE 5,BG:COLOR 1:PRINT"U";:COLOR 7:PRINT" for the upper face, ";             :COLOR 1:PRINT"L";:COLOR 7:PRINT" for the left"
  249. 2850  LOCATE 6,BG:PRINT"face, ";:COLOR 1:PRINT"F";:COLOR 7:                           :PRINT" for the front face, ";:COLOR 1:PRINT"R";:COLOR 7:PRINT" for the"
  250. 2860  LOCATE 7,BG:PRINT"right face, ";:COLOR 1:PRINT"B";:COLOR 7                      :PRINT" for the back face and ";:COLOR 1:PRINT"D":COLOR 7
  251. 2870  LOCATE 8,BG:PRINT"for the downward face. The twists will"
  252. 2880  LOCATE 9,BG:PRINT"be clockwise. To make a counterclock-"
  253. 2890  LOCATE 10,BG:PRINT"wise twist, the letter is followed by"
  254. 2900  LOCATE 11,BG:PRINT"a ";:COLOR 1:PRINT"'";:COLOR 7:PRINT" (e.g. ";               :COLOR 1:PRINT"L'";:COLOR 7:PRINT" ). To change the display,"
  255. 2910  LOCATE 12,BG:PRINT"enter either the word ";:COLOR 1:PRINT"Labels";              :COLOR 7:PRINT" or ";:COLOR 1:PRINT"Colors";:COLOR 7
  256. 2920  IF CLRMON THEN LOCATE 12,BG:PRINT"enter the word ";:COLOR 1:PRINT "Big";:                      COLOR 7:PRINT" or ";
  257. 2930  LOCATE 13,BG:PRINT"or ";:COLOR 1:PRINT"Faces";:COLOR 7:PRINT" or ";             :COLOR 1:PRINT"Codes";:COLOR 7:PRINT". Use ";:COLOR 1:PRINT"Skip";:COLOR 7      :PRINT" to resume/"
  258. 2940  LOCATE 14,BG:PRINT"skip verification. Use ";:COLOR 1:PRINT"New";:COLOR 7        :PRINT" to restart."
  259. 2950  IF NOT BIG THEN RETURN
  260. 2960  LOCATE 15,3:PRINT "To accommodate those using television ";
  261. 2970  PRINT "  sets (i.e. confined to WIDTH 40), the ";
  262. 2980  PRINT "  commands ";:COLOR 1:PRINT "List";:COLOR 7:PRINT " & ";:COLOR 1
  263. 2990  PRINT "Help";:COLOR 7:PRINT " have been added."
  264. 3000  RETURN
  265. 3020  LOCATE 25,9:PRINT "Press the spacebar to continue";
  266. 3030  IF INKEY$<>" " THEN 3030
  267. 3040  LOCATE 25,3:COLOR 1,4:PRINT TITLE$;:COLOR 7,0:RETURN
  268. 3060  LOCATE 1,19:COLOR BR(2),,BR(4):PRINT "Twists: ";
  269. 3070  FOR LI=1 TO 2:LOCATE LI,25+LI
  270. 3080      FOR TI=1 TO 3
  271. 3090          FOR DI=0 TO 1
  272. 3100              COLOR BR((LI-1)*3+TI)
  273. 3110              IF DI THEN PU$="!' " ELSE PU$="! "
  274. 3120              PRINT USING PU$;MID$(T$,(LI-1)*3+TI);
  275. 3130          NEXT
  276. 3140      NEXT
  277. 3150  NEXT
  278. 3160  LOCATE 4,31:COLOR BR(6):PRINT "Commands:";
  279. 3170  FOR CM=1 TO 9
  280. 3180      LOCATE 5+CM,35
  281. 3190      COLOR BR(CM MOD 6+1)
  282. 3200      PRINT DM$(CM)
  283. 3210  NEXT
  284. 3220  COLOR 7:RETURN
  285. 3240  FOR FACE=1 TO 6
  286. 3250      READ PLACE$(1,FACE)
  287. 3260  NEXT
  288. 3270  DATA"upper","left","front","right","back","down"
  289. 3280  FOR FACE=1 TO 6
  290. 3290      READ YOURS$(FACE)
  291. 3300  NEXT
  292. 3310  DATA"white","orange","blue","red","green","yellow"
  293. 3320  FOR P=1 TO 8
  294. 3330      READ XOF(P),YOF(P)
  295. 3340  NEXT
  296. 3350  DATA -1,-3,-1,0,-1,3,0,3,1,3,1,0,1,-3,0,-3
  297. 3360  FOR FA=1 TO 6
  298. 3370      READ XBL(FA),YBL(FA)
  299. 3380  NEXT
  300. 3390  DATA 2,4,13,3,4,19,13,19,13,27,17,17
  301. 3400  FOR FA=1 TO 6
  302. 3410      READ REL(FA),RELY(FA)
  303. 3420  NEXT
  304. 3430  DATA 1,2,3,0,3,2,3,4,3,6,5,2
  305. 3440  FOR F=1 TO 6
  306. 3450      READ X(F),Y(F)
  307. 3460  NEXT
  308. 3470  DATA 2,14,6,4,6,14,6,24,6,34,10,14
  309. 3480  FOR F=1 TO 6
  310. 3490      READ OC$(F)
  311. 3500  NEXT
  312. 3510  DATA "21514131","17376753","15476123","13576333","11276543","25354555"
  313. 3520  FOR DMI=1 TO 9
  314. 3530      READ DM$(DMI)
  315. 3540  NEXT
  316. 3550  DATA CODE,FACE,COLOR,LABEL,NEW,BIG,LIST,HELP,SKIP
  317. 3560  DIRECTION$(0)="clockwise":DIRECTION$(2)="counterclockwise"
  318. 3570  T$="ULFRBD"
  319. 3580  TWISTSSOFAR$(0)="The list of twists so far :"
  320. 3590  TITLE$=SPACE$(7)+"RUBIK'S CUBE SIMULATOR"+SPACE$(7)
  321. 3600  RETURN
  322. 3620  DEF SEG=0
  323. 3630  IF (PEEK(&H410) AND &H30)<>&H30 THEN CLRMON=-1
  324. 3640  DM=1
  325. 3650  LABEL=-1
  326. 3660  RETURN
  327. 3680  IF CLRMON THEN COLOR 1,4:WIDTH 40:K=1 ELSE WIDTH 80:K=21
  328. 3690  CLS:LOCATE 3,2+K:PRINT TITLE$
  329. 3700  LOCATE 6,15+K:PRINT"PC MAGAZINE"
  330. 3710  LOCATE ,15+K:COLOR 7:PRINT"march, 1982"
  331. 3720  LOCATE 24,19+K:PRINT"press the spacebar";
  332. 3730  IF INKEY$<>" " THEN 3730
  333. 3740  COLOR 7,0
  334. 3750  RETURN
  335. 3770  CLS
  336. 3780  LOCATE 2,7+K
  337. 3790  K$="*** COLORING THE CUBE ***"
  338. 3810  IF CLRMON THEN 3880
  339. 3830  PRINT K$
  340. 3840  LOCATE 9,K+6
  341. 3850  PRINT"(The name of each color":PRINT SPC(11+K)"should begin with a":
  342. 3860  PRINT SPC(16+K)"different letter.)":GOTO 4080
  343. 3880  FOR L=1 TO 25
  344. 3890      COLOR (L MOD 7)+1
  345. 3900      PRINT MID$(K$,L,1);
  346. 3910  NEXT
  347. 3920  LOCATE 4,4
  348. 3930  FOR C=1 TO 7
  349. 3940      COLOR ,C
  350. 3950      PRINT "     ";
  351. 3960      COLOR C,0
  352. 3970      PRINT "---";C;
  353. 3980      PRINT SPC(10)
  354. 3990  NEXT
  355. 4000  LOCATE 9,1
  356. 4010  COLOR 1,4
  357. 4020  PRINT "Choose each face's color by entering the";
  358. 4030  PRINT "appropriate number from the list above, ";
  359. 4040  COLOR 0,2
  360. 4050  PRINT "or just press [RETURN] for each face and";
  361. 4060  PRINT "the computer will choose the colors.    "
  362. 4080  LOCATE 15,K
  363. 4090  COLOR 23,0:PRINT"Enter";
  364. 4100  COLOR 7:PRINT" a color for each face:"
  365. 4110  PRINT
  366. 4120  FOR FACE = 1 TO 6
  367. 4130      LOCATE FACE+16,15+K:COLOR 0,7:PRINT USING" \    \";PLACE$(1,FACE);
  368. 4140      COLOR 7,0:INPUT;" ";PLACE$(2,FACE)
  369. 4150      IF CLRMON THEN 4190
  370. 4160      IF PLACE$(2,FACE)="" THEN PLACE$(2,FACE)=YOURS$(FACE)
  371. 4170      GOTO 4240
  372. 4190      IF PLACE$(2,FACE)="" THEN BR(FACE)=FACE:GOTO 4220                               ELSE BR(FACE)=VAL(PLACE$(2,FACE))
  373. 4200      IF BR(FACE)<1 OR BR(FACE)>7 THEN LOCATE ,26:PRINT SPC(14):GOTO 4130
  374. 4210      IF ASC(PLACE$(2,FACE))<56 THEN PLACE$(2,FACE)=MID$(PLACE$(2,FACE),2)
  375. 4220      COLOR 7,0:LOCATE ,24:PRINT "= ";
  376. 4230      COLOR 0,BR(FACE):PRINT PLACE$(2,FACE)+"     "
  377. 4240  NEXT
  378. 4260  COLOR 7,0
  379. 4270  LOCATE 15,K:PRINT "*Chosen ";
  380. 4280  LOCATE 9,K
  381. 4290  COLOR 1,4
  382. 4300  PRINT "  Check each face and its chosen color. ";
  383. 4310  COLOR 7,0
  384. 4320  PRINT SPC(79)" ";
  385. 4330  LOCATE 11,K
  386. 4340  COLOR 5,2
  387. 4350  PRINT "Press the spacebar to start over...  or,";
  388. 4360  COLOR ,0
  389. 4370  PRINT SPC(79)" ";
  390. 4380  LOCATE 13,K
  391. 4390  COLOR 4,6
  392. 4400  PRINT "if everything is okay press the `G' key."
  393. 4410  COLOR 7,0
  394. 4420  G$=INKEY$
  395. 4430  IF G$=" " THEN 3770
  396. 4440  IF G$<>"G" AND G$<>"g" THEN 4420
  397. 4450  RETURN
  398. 4460  END
  399.